home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 033a / cal14s23.zip / CALLS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-01-09  |  71KB  |  2,534 lines
  1.  
  2. {$M 50000,30000,500000}  {Stack, minheap, maxheap}
  3.  
  4. {$V-}    {Relax string rules}
  5. {$S-}    {Stack testing}
  6. {$R-}    {Range checks}
  7. {$L+}    {Local debug info}
  8. {$D+}    {Global debug info}
  9.  
  10. program caller_log_report;
  11.  
  12. uses Dos, Qread, ansiCrt, MdosIO, openShare;
  13.  
  14.  
  15. {                 PCBoard Call Analyzer Ver. 11.7  02/19/87                }
  16. {                                                                          }
  17. {       PCBoard Call Analyzer written by Warren Lauzon of Phoenix AZ       }
  18. {                 Phoenix Techline PCBoard   602-936-3058                  }
  19. {                                                                          }
  20. {      (updated for PCBoard 11.8 and PCB ProDOOR, S.H.Smith, 09/02/87)     }
  21. {              (updated for PCBoard 14.1 S.H.Smith, 08/02/89)              }
  22.  
  23.  
  24. const
  25.    version     = '14s23';
  26.    reldate     = '01-09-92';
  27.    pcbversion  = 'For PCBoard v14.x';
  28.  
  29. type
  30.    anystring   = string[80];
  31.    FileStr     = string[64]; {array[1..64] of char;}
  32.    char64      = array[1..64] of char;
  33.    ItemNameStr = string[20];
  34.  
  35.    ItemPointer = ^ItemList;
  36.    ItemList    = record
  37.                      name:    ItemNameStr;
  38.                      count:   real;
  39.                      next:    ItemPointer;
  40.                end;
  41.  
  42.    FilePointer = ^FileRec;
  43.    FileRec     = record
  44.                      name:    string[16];
  45.                      count:   longint;
  46.                      size:    longint;
  47.                      higher:  FilePointer;
  48.                      lower:   FilePointer;
  49.                end;
  50.  
  51.    ProtocolRecord = record
  52.                      Code:       char;
  53.                      Name:       string[20];
  54.                      Uploads:    longint; {count of uploads}
  55.                      UpTime:     real; {time spent uploading}
  56.                      UpIdeal:    real; {ideal time if 100% efficient}
  57.                      Downloads:  longint;
  58.                      DownTime:   real;
  59.                      DownIdeal:  real;
  60.                end;
  61.  
  62. const
  63.    OldProtocolCount = 27;
  64.    ProtocolCount = 56;
  65.    Protocol:  array[1..ProtocolCount] of ProtocolRecord = (
  66.       (Code:  'A'; Name:  'ASCII'),
  67.       (Code:  'B'; Name:  'B'),
  68.       (Code:  'C'; Name:  'CRC Xmodem'),
  69.       (Code:  'D'; Name:  'D'),
  70.       (Code:  'E'; Name:  'E'),
  71.       (Code:  'F'; Name:  'Full Flow'),
  72.       (Code:  'G'; Name:  'Ymodem-G (dsz)'),
  73.       (Code:  'H'; Name:  'HS/Link'),
  74.       (Code:  'I'; Name:  'I'),
  75.       (Code:  'J'; Name:  'Jmodem'),
  76.       (Code:  'K'; Name:  'Kermit'),
  77.       (Code:  'L'; Name:  'Sysop (Local)'),
  78.       (Code:  'M'; Name:  'MobyTurbo Zmodem'),
  79.       (Code:  'N'; Name:  'N'),
  80.       (Code:  'O'; Name:  '1K-Xmodem'),
  81.       (Code:  'P'; Name:  'PCP-Zmodem'),
  82.       (Code:  'Q'; Name:  'Q'),
  83.       (Code:  'R'; Name:  'Zmodem Resume'),
  84.       (Code:  'S'; Name:  'S'),
  85.       (Code:  'T'; Name:  'T'),
  86.       (Code:  'U'; Name:  'U'),
  87.       (Code:  'V'; Name:  'V'),
  88.       (Code:  'W'; Name:  'WXmodem'),
  89.       (Code:  'X'; Name:  'Xmodem'),
  90.       (Code:  'Y'; Name:  'Ymodem'),
  91.       (Code:  'Z'; Name:  'Zmodem'),
  92.  
  93.       (Code:  '0'; Name:  '0'),
  94.       (Code:  '1'; Name:  '1'),
  95.       (Code:  '2'; Name:  '2'),
  96.       (Code:  '3'; Name:  '3'),
  97.       (Code:  '4'; Name:  '4'),
  98.       (Code:  '5'; Name:  '5'),
  99.       (Code:  '6'; Name:  '6'),
  100.       (Code:  '7'; Name:  '7'),
  101.       (Code:  '8'; Name:  '8'),
  102.       (Code:  '9'; Name:  '9'),
  103.       (Code:  '!'; Name:  '!'),
  104.       (Code:  '@'; Name:  '@'),
  105.       (Code:  '#'; Name:  '#'),
  106.       (Code:  '$'; Name:  '$'),
  107.       (Code:  '%'; Name:  '%'),
  108.       (Code:  '^'; Name:  '^'),
  109.       (Code:  '&'; Name:  '&'),
  110.       (Code:  '*'; Name:  '*'),
  111.       (Code:  '+'; Name:  '+'),
  112.       (Code:  '-'; Name:  '-'),
  113.       (Code:  '<'; Name:  '<'),
  114.       (Code:  '>'; Name:  '>'),
  115.       (Code:  '/'; Name:  '/'),
  116.       (Code:  '['; Name:  '['),
  117.       (Code:  ']'; Name:  ']'),
  118.       (Code:  '{'; Name:  '{'),
  119.       (Code:  '}'; Name:  '}'),
  120.       (Code:  '`'; Name:  '`'),
  121.       (Code:  '~'; Name:  '~'),
  122.  
  123.       (Code:  '?'; Name:  'Others')  {must be last}
  124.    );
  125.  
  126.  
  127. {$i stoupper.inc}
  128.  
  129. (* -------------------------------------------------------- *)
  130. const
  131.    red:        string[7] = #27'[1;31m';
  132.    green:      string[7] = #27'[1;32m';
  133.    yellow:     string[7] = #27'[1;33m';
  134.    blue:       string[7] = #27'[1;34m';
  135.    magenta:    string[7] = #27'[1;35m';
  136.    cyan:       string[7] = #27'[0;36m';
  137.    white:      string[7] = #27'[1;37m';
  138.    gray:       string[7] = #27'[0m';
  139.  
  140.  
  141.  
  142. (* -------------------------------------------------------- *)
  143. const
  144.    nodes:         longint = 1;   {number of nodes}
  145.    logsize:       word = 0;
  146.    UsedMinutes:   longint = 0;   {time used, minutes}
  147.    Hours:         longint = 0;   {time used, hours}
  148.    stuff:         longint = 0;
  149.    runtime:       real = 0;      {how long it takes the program to run}
  150.    Endtime:       real = 0;      {End time for program start}
  151.  
  152.    viewmember:    longint = 0;   {number of zip member textviews}
  153.    extmember:     longint = 0;   {number of zip member extracts}
  154.    repacks:       longint = 0;   {number of re-ziphive runs}
  155.    testexec:      longint = 0;   {number of ziphives tested}
  156.    viewexec:      longint = 0;   {number of 'view executed'}
  157.    backdos:       longint = 0;   {number of times back from dos}
  158.    batchs:        longint = 0;   {number of batch transfers}
  159.    baud:          word = 0;      {current caller's baud rate}
  160.    clevel:        anystring = '';{current caller's security leve]}
  161.    blts:          longint = 0;   {bulletins read}
  162.    caller:        longint = 0;   {number of callers}
  163.    comments:      longint = 0;   {number of comments}
  164.    dirscan:       longint = 0;   {number of DIR scans}
  165.    DOORs:         longint = 0;   {number of DOORs opened}
  166.    DosTimes:      longint = 0;   {how many times dropped to DOS}
  167.    down:          longint = 0;   {number of downloads}
  168.    d_abort:       longint = 0;   {number of download aborts}
  169.    events:        longint = 0;   {event timer activated}
  170.    even_parity:   longint = 0;   {7E callers}
  171.    free_down:     longint = 0;   {free downloads}
  172.    graphics:      longint = 0;   {graphics callers}
  173.    joins:         longint = 0;   {number of conference joins}
  174.    kills:         longint = 0;   {messages killed}
  175.    lockouts:      longint = 0;   {Automatic lockouts done}
  176.    mssgs:         longint = 0;   {messages left}
  177.    Qmssgs:        longint = 0;   {Qmail messages left}
  178.    Mmssgs:        longint = 0;   {Markmail messages left}
  179.    new_guys:      longint = 0;   {new users registered}
  180.    non_graphics:  longint = 0;   {non-graphics callers}
  181.    sysop_paged:   longint = 0;   {sysop pages}
  182.    pwfail:        longint = 0;   {password fails}
  183.    question:      longint = 0;   {main questionnaire answered}
  184.    refused:       longint = 0;   {refused to register}
  185.    secviol:       longint = 0;   {security violations}
  186.    start_time:    real = 0;      {0 time for program start}
  187.    sysop_local:   longint = 0;   {local sysop sessions}
  188.    sysop_remote:  longint = 0;   {remote sysop sessions}
  189.    tcan:          longint = 0;   {number of trashcan name attempts}
  190.    time_limit:    longint = 0;   {daily time limit exceeded}
  191.    UniqFiles:     longint = 0;   {number of dIfferent files}
  192.    up:            longint = 0;   {number of uploads}
  193.    u_abort:       longint = 0;   {number of upload aborts}
  194.    zipmail:       longint = 0;   {number of ARCM runs}
  195.    msgcount:      longint = 0;   {number of ARCM messges}
  196.    invalids:      longint = 0;   {number of invalid uploads}
  197.    schat:         longint = 0;   {sysop chat initiated}
  198.    nchat:         longint = 0;   {node chat initiated}
  199.    DosTime:       longint = 0;   {time spent in remote DOS}
  200.    libdisk:       longint = 0;
  201.  
  202.    event_time:    anystring = '';{time last event started or '' if none}
  203.    event_mins:    longint = 0;   {minutes spent processing events}
  204.  
  205.    spare1:        longint = 0;
  206.    spare2:        longint = 0;
  207.    spare3:        longint = 0;
  208.    spare4:        longint = 0;
  209.    spare6:        longint = 0;
  210.    spare7:        longint = 0;
  211.    spare8:        longint = 0;
  212.    spare9:        longint = 0;
  213.    spare10:       longint = 0;
  214.    spare11:       longint = 0;
  215.    spare12:       longint = 0;
  216.    spare13:       longint = 0;
  217.    spare14:       longint = 0;
  218.    spare15:       longint = 0;
  219.    spare16:       longint = 0;
  220.  
  221.  
  222.    Inrec:         FileStr = '';  {64 char line}
  223.    Urec:          anystring = '';{upper case version of inrec}
  224.  
  225.    PeriodCovered: anystring = '';{concats to send to ofd}
  226.  
  227.    min_download:  longint = 2;   {min downloads to include in report}
  228.  
  229.    saveFile:      anystring = 'CALLS.SAV';    {saved history filename}
  230.  
  231.    inName:        anystring = 'CALLER';   {input filename}
  232.  
  233.    outfile:       anystring = 'BLT99';    {output filename}
  234.  
  235.    reports:       anystring = 'ANBCORPDEFGHIJKLQM';
  236.                                           {list of reports to produce}
  237.  
  238.    {table of peak hours, 'Y'=peak, anything else=not}
  239.                                {          1         2   }
  240.                                {012345678901234567890123}
  241.    PeakTable:     string[24] = 'YNNNNNNNNNNNNNNNNYYYYYYY';
  242.  
  243.    maxConf:       word = maxint;
  244.    maxBlt:        word = maxint;
  245.    maxDoor:       word = maxint;
  246.    maxBatch:      word = maxint;
  247.    maxFree:       word = maxint;
  248.  
  249.    event_mode:    string[20] = 'BUSY';
  250.  
  251.  
  252. const
  253.    FileTree:      FilePointer = nil;
  254.    FirstBatch:    ItemPointer = nil;
  255.    FirstBullet:   ItemPointer = nil;
  256.    FirstConf:     ItemPointer = nil;
  257.    FirstDoor:     ItemPointer = nil;
  258.    FirstBaud:     ItemPointer = nil;
  259.    FirstConType:  ItemPointer = nil;
  260.    FirstSecLevel: ItemPointer = nil;
  261.    FirstFreeDL:   ItemPointer = nil;
  262.  
  263.    FirstAvemins:  ItemPointer = nil;
  264.    FirstSpare3:   ItemPointer = nil;
  265.    FirstSpare4:   ItemPointer = nil;
  266.    FirstSpare5:   ItemPointer = nil;
  267.    FirstSpare6:   ItemPointer = nil;
  268.    FirstSpare7:   ItemPointer = nil;
  269.    FirstSpare8:   ItemPointer = nil;
  270.  
  271.    filever:       integer = 0;
  272.  
  273.    last_rec:      anystring = '';   {last entry in log}
  274.    last_entry:    anystring = '';   {last entry in log}
  275.    last_rec_seen: anystring = '';   {last entry in current log}
  276.  
  277.    first_rec:     anystring = '';   {first entry in log}
  278.    first_entry:   anystring = '';   {first entry in log}
  279.  
  280.    TotHours:      real = 0;         {Total hours from first to last log entry}
  281.    end_hours:     real = 0;
  282.    beg_hours:     real = 0;
  283.  
  284.    Hrs:           array[0..23] of longint = {minutes used by hours}
  285.          (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
  286.  
  287. var
  288.    ifd:  text;   {caller log}
  289.  
  290.    ofd:  text;   {file that goes to the bulletin}
  291.  
  292.    iobuf: array[1..10240] of char;
  293.  
  294.  
  295. const
  296.    graph_num = 100;
  297.    graph_set:  string[3] = '░▓▒';
  298.  
  299. type
  300.    sort_keys = (percent_sort, name_sort, no_sort);
  301.  
  302. const
  303.    graph_min:    longint = 0;
  304.    graph_max:    longint = 0;
  305.    graph_lim:    real = 0;
  306.    graph_line:   longint = 0;
  307.    graph_count:  integer = 0;
  308. var
  309.    graph_val:    array[1..graph_num] of real;
  310.    graph_title:  array[1..graph_num] of string[20];
  311.  
  312. const
  313.    pcol: string = '';
  314.  
  315.  
  316.  
  317. (* -------------------------------------------------------- *)
  318. procedure setcolor(col: string);
  319. begin
  320.    if pcol <> col then
  321.    begin
  322.       write(ofd,col);
  323.       pcol := col;
  324.    end;
  325. end;
  326.  
  327.  
  328. (* -------------------------------------------------------- *)
  329. function itoa(l: longint): anystring;
  330. var
  331.    s: anystring;
  332. begin
  333.    str(l,s);
  334.    itoa := s;
  335. end;
  336.  
  337. function wtoa(w: word): anystring;
  338. var
  339.    s: anystring;
  340. begin
  341.    str(w,s);
  342.    wtoa := s;
  343. end;
  344.  
  345.  
  346. (* -------------------------------------------------------- *)
  347. procedure section_title(title:  anystring);
  348.    begin
  349.       writeln(ofd);
  350.       writeln(ofd, '':  35-(length(title) div 2),
  351.             red, '-= ', yellow, title, red, ' =-');
  352.       writeln(ofd);
  353.    end;
  354.  
  355.  
  356. (* -------------------------------------------------------- *)
  357. procedure empty_section;
  358.    begin
  359.       writeln(ofd, gray, '':34,'**NONE**');
  360.    end;
  361.  
  362.  
  363. (* -------------------------------------------------------- *)
  364. procedure start_graph(title:  anystring; limit:  real);
  365.    begin
  366.       graph_lim := limit;
  367.       graph_max := 0;
  368.       graph_min := 100;
  369.       graph_line := 0;
  370.       graph_count := 0;
  371.       section_title(title);
  372.    end;
  373.  
  374. (* -------------------------------------------------------- *)
  375. procedure graph(item:  anystring; n:  real);
  376.    var
  377.       pct:  real;
  378.    begin
  379.       if graph_lim = 0 then
  380.          pct := 0
  381.       else
  382.          pct := abs(n/graph_lim)*100.0;
  383.       if (pct <= 0) or (pct > maxint) then
  384.          exit;
  385.  
  386.       if pct > graph_max then
  387.          graph_max := trunc(pct);
  388.       if pct < graph_min then
  389.          graph_min := trunc(pct*0.7);
  390.  
  391.       if graph_count < graph_num then
  392.          inc(graph_count);
  393.  
  394.       graph_val[graph_count] := n;
  395.       graph_title[graph_count] := item;
  396.    end;
  397.  
  398.  
  399. (* -------------------------------------------------------- *)
  400. procedure graph_output(item:  anystring; n:  real);
  401.    var
  402.       pct:  real;
  403.       i:    integer;
  404.       w:    integer;
  405.       lim:  longint;
  406.    begin
  407.       if graph_line < length(graph_set) then
  408.          inc(graph_line)
  409.       else
  410.          graph_line := 1;
  411.  
  412.       if graph_lim = 0 then
  413.          pct := 0
  414.       else
  415.          pct := abs(n/graph_lim*100.0);
  416.  
  417.       if pct > 150 then
  418.          pct := 150;
  419.  
  420.       write(ofd, green, item:20, ': ', white);
  421.  
  422.       if graph_lim < 0 then
  423.          if pct > 99.9 then
  424.             write(ofd, pct:3:0,' % ')
  425.          else
  426.             write(ofd, pct:4:1, '% ')
  427.       else
  428.  
  429.       begin
  430.          if (int(graph_lim) <> graph_lim) and (graph_lim < 9999.0) then
  431.             write(ofd, n:6:1)
  432.          else
  433.             write(ofd, n:5:0);
  434.  
  435.          if pct > 99.9 then
  436.             write(ofd,gray, ' (',pct:3:0,' %) ')
  437.          else
  438.             write(ofd,gray,' (', pct:4:1, '%) ');
  439.       end;
  440.  
  441.       if graph_lim < 0 then lim := 50 else lim := 42;
  442.  
  443.       if (pct < graph_min) then
  444.          w := 0
  445.       else
  446.       if (graph_min = graph_max) then
  447.          w := lim
  448.       else
  449.          w := round((pct-graph_min)/(graph_max-graph_min)*lim);
  450.  
  451.       if w > lim then
  452.          w := lim;
  453.  
  454.       write(ofd, white, '│', cyan);
  455.  
  456.       for i := 1 to w-1 do
  457.          write(ofd, graph_set[graph_line]);
  458.       if w > 0 then
  459.          write(ofd, white, '█');
  460.  
  461.       writeln(ofd);
  462.    end;
  463.  
  464.  
  465.    (* -------------------------------------------------------- *)
  466.    procedure sort_graph(onkey: sort_keys);
  467.    var
  468.       ts:   string[20];
  469.       tv:   real;
  470.       swap: boolean;
  471.       i,j:  integer;
  472.  
  473.       function swap_needed: boolean;
  474.       begin
  475.          if onkey = percent_sort then
  476.             tv := graph_val[i]-graph_val[i+1]
  477.          else
  478.             tv := 0;
  479.          if tv = 0 then
  480.             if graph_title[i] > graph_title[i+1] then
  481.                tv := -1;
  482.          swap_needed := (tv < 0);
  483.       end;
  484.       
  485.       (* -------------------------------------------------------- *)
  486.       procedure swap_entries;
  487.       begin
  488.          swap := true;
  489.          tv := graph_val[i+1];
  490.          graph_val[i+1] := graph_val[i];
  491.          graph_val[i] := tv;
  492.          ts := graph_title[i+1];
  493.          graph_title[i+1] := graph_title[i];
  494.          graph_title[i] := ts;
  495.       end;
  496.  
  497.    begin
  498.  
  499.      j := graph_count;
  500.      repeat
  501.          swap := false;
  502.          dec(j);
  503.          for i := 1 to j do
  504.             if swap_needed then
  505.                swap_entries;
  506.       until swap = false;
  507.    end;
  508.  
  509.  
  510. (* -------------------------------------------------------- *)
  511. procedure end_graph(onkey: sort_keys; maxcnt: word);
  512.    var
  513.       i:  integer;
  514.  
  515.    begin
  516.       if onkey <> no_sort then
  517.          sort_graph(onkey);
  518.  
  519.       if graph_count > maxcnt then
  520.          graph_count := maxcnt;
  521.  
  522.       for i := 1 to graph_count do
  523.          graph_output(graph_title[i], graph_val[i]);
  524.  
  525.       if graph_count = 0 then
  526.          empty_section;
  527.  
  528.       writeln(ofd);
  529.    end;
  530.  
  531.  
  532. (* -------------------------------------------------------- *)
  533.    procedure graph_list(node:    ItemPointer;
  534.                         title:   string;
  535.                         n:       real;
  536.                         key:     sort_keys;
  537.                         maxcnt:  word);
  538.    begin
  539.       if maxcnt = maxint then
  540.          start_graph(title,n)
  541.       else
  542.          start_graph('Top '+itoa(maxcnt)+' '+title,n);
  543.  
  544.       while (node <> nil) do
  545.       begin
  546.          graph(node^.name, node^.count);
  547.          node := node^.next;
  548.       end;
  549.  
  550.       end_graph(key,maxcnt);
  551.    end;
  552.  
  553.  
  554. (* -------------------------------------------------------- *)
  555. procedure walk_tree( var Node:  FilePointer;
  556.                      var a:  integer);
  557.    {traverse the binary filename tree and output in sorted order}
  558. begin
  559.    if Node = nil then exit;
  560.  
  561.    walk_tree(Node^.lower, a);
  562.  
  563.    if Node^.count >= min_download then
  564.    begin
  565.       case Node^.count-min_download of
  566.          0.. 2: write(ofd, cyan,   '     ');
  567.          3.. 6: write(ofd, green,  '   * ');
  568.          7..12: write(ofd, red,    '  ** ');
  569.         13..24: write(ofd, yellow, ' *** ');
  570.          else   write(ofd, white,  '**** ');
  571.       end;
  572.  
  573.       write(ofd, Node^.name:  12, Node^.count:  5);
  574.  
  575.       if a mod 3 = 0 then
  576.          writeln(ofd)
  577.       else
  578.          write(ofd,'   ');
  579.  
  580.       inc(a);
  581.    end;
  582.  
  583.    walk_tree(Node^.higher, a);
  584. end;
  585.  
  586.  
  587. (* -------------------------------------------------------- *)
  588. procedure output_results(outfile: anystring);
  589.    var
  590.       UsedHours:  real;
  591.       DownEffic:  real;
  592.       UpEffic:    real;
  593.       daymsg:     anystring;
  594.       Days:       longint;
  595.       report:     integer;
  596.       c:          char;
  597.       PeakUsed:   real;
  598.       PeakHours:  real;
  599.  
  600.       procedure init_report;
  601.       var
  602.          i,j: integer;
  603.       begin
  604.          gotoxy(15, 15);
  605.          highvideo;
  606.          textcolor(ansicrt.yellow);
  607.  
  608.          gotoxy(1, 2);
  609.          write('Sending output to ', outfile,' ');
  610.  
  611.          assign(ofd, outfile);
  612.          rewrite(ofd);
  613.          setTextbuf(ofd,iobuf);
  614.  
  615.          UsedHours := int(UsedMinutes)/60.0+int(Hours);
  616.  
  617.          if TotHours < 1 then
  618.             TotHours := 1;
  619.          Days := trunc( (TotHours+23.9) /24.0 );
  620.          daymsg := itoa((days{+nodes-1}) div nodes);
  621.  
  622.          {calculate number of hours in peak times}
  623.          i := 0;
  624.          for j := 0 to 23 do
  625.             if PeakTable[j+1] = 'Y' then
  626.                inc(i);
  627.          if i = 0 then
  628.             i := 24;
  629.          PeakHours := TotHours / 24.0 * int(i);
  630.  
  631.          {calculate time used in peak times}
  632.          if i = 24 then
  633.             PeakUsed := UsedHours
  634.          else
  635.          begin
  636.             PeakUsed := 0;
  637.             for j := 0 to 23 do
  638.                if PeakTable[j+1] = 'Y' then
  639.                   PeakUsed := PeakUsed + int(hrs[j])/60.0;
  640.          end;
  641.  
  642.          writeln(ofd,white);
  643.          writeln(ofd, '               Calls ', version, ' - Call Analyzer ',pcbversion);
  644.          writeln(ofd, blue, '            ', PeriodCovered);
  645.       end;
  646.  
  647.       procedure system_statistics;
  648.       begin
  649.          if nodes > 1 then
  650.             section_title('Combined Statistics for '+itoa(nodes)+' nodes over '+daymsg+' days')
  651.          else
  652.             section_title('System Statistics for '+daymsg+' days');
  653.  
  654.          if (caller = 0) or (days = 0) or
  655.             (totHours = 0) or (peakHours = 0) then exit;
  656.  
  657.          write  (ofd, green, '  Directory Scans........ ', white, dirscan:6);
  658.          writeln(ofd, green, '  Messages Left.......... ':33, white, mssgs:6);
  659.  
  660.          write  (ofd, green, '  Doors Opened........... ', white, DOORs:6);
  661.          writeln(ofd, green, '    Comments Left........ ':33, white, comments:6);
  662.  
  663.          write  (ofd, green, '  Downloads Completed.... ', white, down:6);
  664.          writeln(ofd, green, '    Qmail Messages Left.. ':33, white, Qmssgs:6);
  665.  
  666.          write  (ofd, green, '    Different Files...... ', white, UniqFiles:6);
  667.          writeln(ofd, green, '    MarkMail Messages.... ':33, white, Mmssgs:6);
  668.  
  669.          write  (ofd, green, '    Downloads Aborted.... ', white, d_abort:6);
  670.          writeln(ofd, green, '    ZIPM Executed........ ':33, white, zipmail:6);
  671.  
  672.          write  (ofd, green, '    Free Downloads....... ', white, free_down:6);
  673.          writeln(ofd, green, '    ZIPM Messages........ ':33, white, msgcount:6);
  674.  
  675.          write  (ofd, green, '  LIB Executed........... ', white, libdisk:6);
  676.          writeln(ofd, green, '  Number of Callers...... ':33, white, caller:6);
  677.  
  678.          write  (ofd, green, '  REPACK Executed........ ', white, repacks:6);
  679.          writeln(ofd, green, '    New Users Registered. ':33, white, new_guys:6);
  680.  
  681.          write  (ofd, green, '  TEST Executed.......... ', white, testexec:6);
  682.          writeln(ofd, green, '    Ave. Calls Per Day... ':33, white, nodes*caller/Days:6:1);
  683.  
  684.          write  (ofd, green, '  Uploads Completed...... ', white, up:6);
  685.          writeln(ofd, green, '    Ave. Call Duration... ':33, white, (UsedHours*60)/caller:6:1);
  686.  
  687.          write  (ofd, green, '    Bad Uploads Deleted.. ', white, invalids:6);
  688.          writeln(ofd, green, '    Ave. Idle Time....... ':33, white, (TotHours-UsedHours)*60/caller:6:1);
  689.  
  690.          write  (ofd, green, '    Uploads Aborted...... ', white, u_abort:6);
  691.          writeln(ofd, green, '  Scripts Completed...... ':33, white, question:6);
  692.  
  693.          write  (ofd, green, '  VIEW Executed.......... ', white, viewexec:6);
  694.          writeln(ofd, green, '  Total Operation Hours.. ':33, white, TotHours:6:1);
  695.  
  696.          write  (ofd, green, '    Members Extracted.... ', white, extmember:6);
  697.          writeln(ofd, green, '    Utilization Hours.... ':33, white, UsedHours:6:1);
  698.  
  699.          write  (ofd, green, '    Members Viewed....... ', white, viewmember:6);
  700.          writeln(ofd, green, '    Total Utilization %.. ':33, white, (UsedHours/TotHours)*100:6:1);
  701.  
  702.          write  (ofd, '':32);
  703.          writeln(ofd, green, '    Peak Utilization %... ':33, white, (PeakUsed/PeakHours)*100:6:1);
  704.          writeln(ofd);
  705.       end;
  706.  
  707.       procedure security_statistics;
  708.       var
  709.          evmins:  real;
  710.       begin
  711.          section_title('Security Statistics');
  712.  
  713.          write  (ofd, green, '  Automatic Lockouts..... ', white, lockouts:6);
  714.          writeln(ofd, green, '  Node Chats Initiated... ':33, white, nchat:6);
  715.  
  716.          write  (ofd, green, '  Password Failures...... ', white, pwfail:6);
  717.          writeln(ofd, green, '  Sysop Chats Initiated.. ':33, white, schat:6);
  718.  
  719.          write  (ofd, green, '  Refused to Register.... ', white, refused:6);
  720.          writeln(ofd, green, '  Sysop Paged............ ':33, white, sysop_paged:6);
  721.  
  722.          write  (ofd, green, '  Remote DOS Time (min).. ', white, DosTime:6);
  723.          writeln(ofd, green, '  Sysop Sessions......... ':33, white, sysop_local+sysop_remote:6);
  724.  
  725.          write  (ofd, green, '  Remote Drops to DOS.... ', white, DosTimes:6);
  726.          writeln(ofd, green, '  Time Limit Expired..... ':33, white, time_limit:6);
  727.  
  728.          write  (ofd, green, '  Scheduled Events....... ', white, events:6);
  729.          writeln(ofd, green, '  Trashcan Names......... ':33, white, tcan:6);
  730.  
  731.          if event_mode = 'OFF' then
  732.             write(ofd, '':32)
  733.          else
  734.          begin
  735.             if events = 0 then
  736.                evmins := 0
  737.             else
  738.                evmins := event_mins/(events*nodes);
  739.             write  (ofd, green, '  Ave Event Length (min). ', white, evmins:6:1);
  740.          end;
  741.  
  742.          writeln(ofd, green, '  Security Violations.... ':33, white, secviol:6);
  743.          writeln(ofd);
  744.       end;
  745.  
  746.       procedure graphic_modes;
  747.       var
  748.          k: longint;
  749.       begin
  750.          k := (graphics+non_graphics+even_parity);
  751.          start_graph('Graphics Modes', k);
  752.          graph('Color Graphics', graphics);
  753.          graph('Non Graphics', non_graphics);
  754.          graph('7 Bit Even-Parity', even_parity);
  755.          end_graph(percent_sort,maxint);
  756.       end;
  757.  
  758.       procedure baud_rates;
  759.       begin
  760.          graph_list(FirstBaud,'Baud Rates', caller, percent_sort, maxint);
  761.       end;
  762.  
  763.       procedure connect_types;
  764.       begin
  765.          graph_list(FirstConType,'Connect Types', caller, percent_sort, maxint);
  766.       end;
  767.  
  768.       procedure security_levels;
  769.       begin
  770.          graph_list(FirstSecLevel,'Number of Calls by Security Level', caller, percent_sort, maxint);
  771.       end;
  772.  
  773.       procedure average_minutes;
  774.       begin
  775.          graph_list(FirstAveMins,'Hours Used by Security Level', UsedMinutes/60.0+UsedHours, percent_sort, maxint);
  776.       end;
  777.  
  778.       procedure free_downloads;
  779.       begin
  780.          graph_list(FirstFreeDL,'Free Downloads', caller, percent_sort, maxFree);
  781.       end;
  782.  
  783.       procedure hourly_usage;
  784.       var
  785.          hits: longint;
  786.          slot: integer;
  787.          a:    integer;
  788.          k:    integer;
  789.          whole_days:  real;
  790.  
  791.       begin
  792.          section_title('Average Percent of Hourly Usage');
  793.  
  794.          write(ofd, green, '       00');
  795.          for a := 1 to 23 do
  796.          begin
  797.             if a < 10 then write(ofd,'  ') else write(ofd,' ');
  798.             write(ofd,a);
  799.          end;
  800.          writeln(ofd);
  801.  
  802.          whole_days := int((TotHours+23)/24) * 0.60;
  803.  
  804.          hits := 0;
  805.          for k := 20 downto 1 do 
  806.          begin
  807.             write(ofd, green, k*5:  3, '%');
  808.             pcol := '';
  809.             setcolor(white);
  810.             write(ofd, ' │ ');
  811.             hits := 0;
  812.  
  813.             for a := 0 to 23 do 
  814.             begin
  815.                c := graph_set[(a mod 3)+1];
  816.                slot := round( (hrs[a] / whole_days) / 5);
  817.                if slot > 20 then
  818.                   slot := 20;
  819.  
  820.                if slot = k then
  821.                begin
  822.                   setcolor(white);
  823.                   write(ofd, '██ ');
  824.                end
  825.                else
  826.  
  827.                if slot > k then
  828.                begin
  829.                   setcolor(cyan);
  830.                   write(ofd, c,c,' ');
  831.                   inc(hits);
  832.                end
  833.                else 
  834.  
  835.                begin
  836.                   setcolor(blue);
  837.                   write(ofd, ' · ');
  838.                end;
  839.             end;
  840.  
  841.             writeln(ofd);
  842.          end;
  843.  
  844.          write(ofd, green, '       00');
  845.          for a := 1 to 23 do
  846.          begin
  847.             if a < 10 then write(ofd,'  ') else write(ofd,' ');
  848.             write(ofd,a);
  849.          end;
  850.          writeln(ofd);
  851.  
  852.          write(ofd, yellow, 'Peak: ', red);
  853.          for a := 0 to 23 do
  854.             if PeakTable[a+1] = 'Y' then
  855.                write(ofd,' **')
  856.             else
  857.                write(ofd,'   ');
  858.          writeln(ofd);
  859.          writeln(ofd);
  860.       end;
  861.  
  862.       procedure conferences_joined;
  863.       begin
  864.          graph_list(FirstConf,'Conferences Joined', joins, percent_sort, maxConf);
  865.       end;
  866.  
  867.       procedure bulletins_read;
  868.       begin
  869.          graph_list(FirstBullet,'Bulletins Read', blts, percent_sort, maxBlt);
  870.       end;
  871.  
  872.       procedure doors_opened;
  873.       begin
  874.          graph_list(FirstDoor,'Doors Opened', DOORs, percent_sort, maxDoor);
  875.       end;
  876.  
  877.       procedure download_protocols;
  878.       var
  879.          k: integer;
  880.       begin
  881.          start_graph('Protocol Usage (Downloading)', down);
  882.          for k := 1 to ProtocolCount do
  883.             with Protocol[k] do
  884.                if (Downloads <> 0) then
  885.                   graph(Name, Downloads);
  886.          end_graph(percent_sort,maxint);
  887.       end;
  888.  
  889.       procedure download_efficiency;
  890.       var
  891.          k: integer;
  892.       begin
  893.          start_graph('Average Protocol Efficiency (Downloading)', -100);
  894.          for k := 1 to ProtocolCount do
  895.             with Protocol[k] do
  896.                if (Downloads <> 0) and (DownTime <> 0) then
  897.                   begin
  898.                      DownEffic := 100.0*DownIdeal/DownTime;
  899.                      graph(Name, DownEffic);
  900.                   end;
  901.          end_graph(percent_sort,maxint);
  902.       end;
  903.  
  904.       procedure upload_protocols;
  905.       var
  906.          k: integer;
  907.       begin
  908.          start_graph('Protocol Usage (Uploading)', up);
  909.          for k := 1 to ProtocolCount do
  910.             with Protocol[k] do
  911.                if (Uploads <> 0) then
  912.                   graph(Name, Uploads);
  913.          end_graph(percent_sort,maxint);
  914.       end;
  915.  
  916.       procedure upload_efficiency;
  917.       var
  918.          k: integer;
  919.       begin
  920.          start_graph('Average Protocol Efficiency (Uploading)', -100);
  921.          for k := 1 to ProtocolCount do
  922.             with Protocol[k] do
  923.                if (Uploads <> 0) and (UpTime <> 0) then
  924.                   begin
  925.                      UpEffic := 100.0*UpIdeal/UpTime;
  926.                      graph(Name, UpEffic);
  927.                   end;
  928.          end_graph(percent_sort,maxint);
  929.       end;
  930.  
  931.       procedure batch_sizes;
  932.       begin                                                    {name_sort}
  933.          graph_list(FirstBatch,'Batch Transfer Sizes', batchs, percent_sort, maxBatch);
  934.       end;
  935.  
  936.       procedure files_downloaded;
  937.       var
  938.          a: integer;
  939.          s: anystring;
  940.       begin
  941.          if min_download = 1 then
  942.             s := ''
  943.          else
  944.             s := ' '+ itoa(min_download) + ' or More Times';
  945.  
  946.          section_title('Files Downloaded'+s);
  947.          if down < 1 then
  948.             empty_section
  949.          else
  950.             begin
  951.                a := 1;
  952.                walk_tree(FileTree, a);
  953.             end;
  954.          writeln(ofd);
  955.       end;
  956.  
  957. (* -------------------------------------------------------- *)
  958.    begin
  959.       init_report;
  960.  
  961.       for report := 1 to length(reports) do
  962.          case upcase(reports[report]) of
  963.            'A': system_statistics;
  964.            'B': graphic_modes;
  965.            'C': baud_rates;
  966.            'D': hourly_usage;
  967.            'E': conferences_joined;
  968.            'F': bulletins_read;
  969.            'G': doors_opened;
  970.            'H': download_protocols;
  971.            'I': download_efficiency;
  972.            'J': upload_protocols;
  973.            'K': upload_efficiency;
  974.            'L': batch_sizes;
  975.            'M': files_downloaded;
  976.            'N': security_statistics;
  977.            'O': security_levels;
  978.            'P': connect_types;
  979.            'Q': free_downloads;
  980.            'R': average_minutes;
  981.            'Z': writeln(ofd);
  982.          end;
  983.  
  984.       write(ofd,gray);
  985.       close(ofd);
  986.    end;
  987.  
  988.  
  989.  
  990. (* -------------------------------------------------------- *)
  991. procedure getrec;
  992.    var
  993.       c:    char;
  994.    begin
  995.       Qreadln(ifd, Inrec, sizeof(Inrec));
  996.       Urec := Inrec;
  997.       stoupper(Urec);
  998.  
  999.       if Urec[3] = '-' then
  1000.          last_rec_seen := Urec;
  1001.  
  1002.       if keypressed then
  1003.       begin
  1004.          c := readkey;
  1005.          if c = #27 then
  1006.          begin
  1007.             gotoxy(1, 24);
  1008.             writeln('** ESC pressed - Aborted **');
  1009.             delay(2000);
  1010.             halt;
  1011.          end;
  1012.       end;
  1013.    end;
  1014.  
  1015.  
  1016.  
  1017. (* -------------------------------------------------------- *)
  1018. procedure add_item(var FirstItem:  ItemPointer;
  1019.                    ItemName:       ItemNameStr;
  1020.                    Number:         real);
  1021. var
  1022.    NewItem:  ItemPointer;
  1023.  
  1024. begin
  1025.    NewItem := FirstItem;
  1026.    while NewItem <> nil do
  1027.       if NewItem^.name = ItemName then
  1028.          begin
  1029.             NewItem^.count := NewItem^.count + Number;
  1030.             exit;
  1031.          end
  1032.       else
  1033.          NewItem := NewItem^.next;
  1034.  
  1035.    new(NewItem);          { get a new record}
  1036.    NewItem^.next := FirstItem;
  1037.    FirstItem := NewItem;
  1038.    NewItem^.name := ItemName;
  1039.    NewItem^.count := Number;
  1040. end;
  1041.  
  1042.  
  1043. (* -------------------------------------------------------- *)
  1044. procedure store_name(var Node:  FilePointer;
  1045.                      var Name:  anystring;
  1046.                      var Size:  longint);
  1047.       {stores the name in the sorted name tree; recursive}
  1048.  
  1049.    begin
  1050.  
  1051.       if Urec[8] = 'U' then
  1052.       begin
  1053.          size := 100000;
  1054.          exit;
  1055.       end;
  1056.  
  1057.  
  1058.       (* insert new nodes *)
  1059.       if Node = nil then
  1060.       begin
  1061.          new(Node);
  1062.          Node^.count := 1;
  1063.          Node^.name := Name;
  1064.          Node^.size := 100000;
  1065.          Size := Node^.size;
  1066.          Node^.higher := nil;
  1067.          Node^.lower := nil;
  1068.          inc(UniqFiles);
  1069.       end
  1070.       else
  1071.  
  1072.       (* count existting nodes *)
  1073.       if Node^.name = Name then
  1074.       begin
  1075.          inc(Node^.count);
  1076.          Size := Node^.size;
  1077.       end
  1078.       else
  1079.  
  1080.       (* else traverse the tree looking for the right node *)
  1081.       if Name > Node^.name then
  1082.          store_name(Node^.higher,Name,Size)
  1083.       else
  1084.          store_name(Node^.lower,Name,Size);
  1085.    end;
  1086.  
  1087.  
  1088. (* -------------------------------------------------------- *)
  1089. function pos(pattern: string; value: string): integer;
  1090. var
  1091.    i: integer;
  1092. begin
  1093.    if length(pattern) = 1 then
  1094.    begin
  1095.       for i := 1 to length(value) do
  1096.          if value[i] = pattern[1] then
  1097.          begin
  1098.             pos := i;
  1099.             exit;
  1100.          end;
  1101.       pos := 0;
  1102.    end
  1103.    else
  1104.       pos := system.pos(pattern,value);
  1105. end;
  1106.  
  1107.  
  1108. (* -------------------------------------------------------- *)
  1109. type
  1110.    str12 = string[12];
  1111.    str80 = string[80];
  1112.  
  1113. {  This Function returns a name expanded to line up both the name and ext    }
  1114. {  for example:  abc.com      =  abc      com                                }
  1115. {                datafile.1   =  datafile   1                                }
  1116.  
  1117. function ExpandName(name:  str12):  str12;
  1118.  
  1119.    var
  1120.       Counter, DotPos:  integer;
  1121.  
  1122.    begin
  1123.       DotPos := pos('.', name); {where's the dot at?}
  1124.       if DotPos = 0 then
  1125.       begin
  1126.          repeat
  1127.             name := name+' '; {If no ext, pad with spaces}
  1128.          until length(name) = 12;
  1129.       end else
  1130.       begin
  1131.          delete(name, DotPos, 1);
  1132.          repeat
  1133.             insert(' ', name, DotPos);
  1134.          until length(name) = 12;
  1135.       end;
  1136.       ExpandName := name;
  1137.    end;
  1138.  
  1139.  
  1140. (* -------------------------------------------------------- *)
  1141. procedure print(col, row:  integer;
  1142.                 str:       str80;
  1143.                 Attrib:    integer);
  1144.    begin
  1145.       gotoxy(col, row);
  1146.       textcolor(Attrib);
  1147.       write(str);
  1148.    end;
  1149.  
  1150.  
  1151. (* -------------------------------------------------------- *)
  1152. function Time:  real;
  1153.    var
  1154.       Reg:  Registers;
  1155.  
  1156.    begin Reg.AX := $2C00;
  1157.       intr($21, Reg);
  1158.       Time := (Reg.CX shr 8)*3600 {Hours}
  1159.              +(Reg.CX and $00FF)*60 {Minutes}
  1160.              +(Reg.DX shr 8)      { * 1 }
  1161.                                   {Seconds    }
  1162.              +(Reg.DX and $00FF)/100; {Hundredths }
  1163.    end;
  1164.  
  1165.  
  1166.  
  1167. (* -------------------------------------------------------- *)
  1168. procedure calculate_event_time;
  1169.    var
  1170.       minbeg,hourbeg:   integer;
  1171.       minend,hourend:   integer;
  1172.       a:                integer;
  1173.       timebeg:          integer;
  1174.       timeend:          integer;
  1175.       mins:             integer;
  1176.  
  1177.    begin
  1178.       val(copy(event_time,1,2),hourbeg,a);
  1179.       if hourbeg > 23 then
  1180.          hourbeg := hourbeg - 24;
  1181.       val(copy(event_time,4,2),minbeg,a);
  1182.       event_time := '';
  1183.  
  1184.       val(copy(Urec,11,2),hourend,a);
  1185.       if hourend > 23 then
  1186.          hourend := hourend - 24;
  1187.       val(copy(Urec,14,2),minend,a);
  1188.  
  1189.       timebeg := hourbeg*60 + minbeg;
  1190.       timeend := hourend*60 + minend;
  1191.       if timeend < timebeg then
  1192.          timeend := timeend + 1440;
  1193.  
  1194.       mins := timeend-timebeg;
  1195.       event_mins := event_mins + mins;
  1196.  
  1197.       if event_mode = 'BUSY' then
  1198.       begin
  1199.          while mins > 0 do
  1200.          begin
  1201.             if mins > minend then
  1202.                a := minend
  1203.             else
  1204.                a := mins;
  1205.  
  1206.             UsedMinutes := UsedMinutes + a;
  1207.             while UsedMinutes > 60 do
  1208.             begin
  1209.                inc(Hours);
  1210.                UsedMinutes := UsedMinutes - 60;
  1211.             end;
  1212.  
  1213.             Hrs[hourend] := Hrs[hourend]+a;
  1214.             mins := mins-a;
  1215.  
  1216.             if hourend > 0 then
  1217.                dec(hourend)
  1218.             else
  1219.                hourend := 23;
  1220.             minend := 60;
  1221.          end;
  1222.       end;
  1223.    end;
  1224.  
  1225.  
  1226.  
  1227. (* -------------------------------------------------------- *)
  1228. procedure incaller;
  1229.    var
  1230.       posit:   integer;
  1231.       num:     integer;
  1232.       j:       integer;
  1233.       temp:    anystring;
  1234.       BaudName:anystring;
  1235.  
  1236.    begin
  1237.       temp := copy(Urec,23,99);
  1238.       posit := pos(') (',temp);
  1239.       if posit = 0 then
  1240.          exit;
  1241.  
  1242.       inc(caller);
  1243.       if pos(' SYSOP (', Urec) > 0 then
  1244.          begin
  1245.             if pos(' (LOCAL) (', Urec) > 0 then
  1246.                inc(sysop_local)
  1247.             else
  1248.                inc(sysop_remote);
  1249.          end;
  1250.  
  1251.       if pos(' (LOCAL) (', Urec) <> 0 then
  1252.       begin
  1253.          BaudName := 'Local ';
  1254.          add_item(FirstBaud, BaudName, 1);
  1255.          baud := 0;
  1256.       end
  1257.       else
  1258.  
  1259.       begin
  1260.          j := posit-1;
  1261.          while (j > 0) and (temp[j] <> '(') do
  1262.             dec(j);
  1263.          inc(j);
  1264.          BaudName := copy(temp,j,posit-j);
  1265.  
  1266.          j := length(BaudName);
  1267.          if BaudName[j] <> 'E' then
  1268.             BaudName := BaudName + ' ';
  1269.  
  1270.          add_item(FirstBaud, BaudName, 1);
  1271.  
  1272.          dec(BaudName[0]);
  1273.          {writeln('baud=[',baudName,']');}
  1274.          baud := 0;
  1275.          val(BaudName,baud,posit);
  1276.       end;
  1277.  
  1278.       if pos('(G', Urec) > 0 then inc(graphics)
  1279.       else if pos('(N', Urec) > 0 then inc(non_graphics)
  1280.       else if pos('(7', Urec) > 0 then inc(even_parity);
  1281.  
  1282.       if pos(' TRASHCAN ', Urec) > 0 then inc(tcan);
  1283.  
  1284.       if event_time <> '' then
  1285.          calculate_event_time;
  1286.  
  1287.       clevel := '';
  1288.    end;
  1289.  
  1290.  
  1291. (* -------------------------------------------------------- *)
  1292. procedure indownload;      {upload/downloaded file stuff}
  1293.    var
  1294.       prot:    char;
  1295.       posit:   integer;
  1296.       k:       integer;
  1297.       CPS:     real;
  1298.       FileName:  string[12];
  1299.       tmp:     string;
  1300.       size:    longint;
  1301.       ideal:   real;
  1302.       Time:    real;
  1303.  
  1304.    begin
  1305.       if Urec[9] <> ')' then exit;
  1306.  
  1307.       if pos(' ABORTED ', Urec) > 0 then
  1308.       begin
  1309.          if Urec[8] = 'D' then
  1310.             inc(d_abort) {Aborted dl's}
  1311.          else
  1312.             inc(u_abort);
  1313.          exit;
  1314.       end;
  1315.  
  1316.       posit := pos(' COMPLETED ', Urec); {find End of name}
  1317.       if posit=0 then exit;
  1318.  
  1319.       {determine file name}
  1320.       FileName := ExpandName(copy(Urec, 11, (posit-11)));
  1321.       if FileName[1] = ' ' then exit;
  1322.  
  1323.       {store name, return file size}
  1324.       store_name(FileTree,FileName,size);
  1325.  
  1326.       {determine transfer time}
  1327.       if baud <> 0 then
  1328.          ideal := size/baud*10.0
  1329.       else
  1330.          ideal := 111;
  1331.  
  1332.       {determine actual transfer time}
  1333.       posit := pos('CPS=', Urec);
  1334.       if posit = 0 then
  1335.          CPS := baud/11.0
  1336.       else
  1337.       begin
  1338.          tmp := copy(Urec,posit+4,6);
  1339.          posit := pos(' ',tmp);
  1340.          tmp := copy(tmp,1,posit-1);
  1341.          CPS := 0;
  1342.          val(tmp,cps,posit);
  1343.       end;
  1344.  
  1345.       if (CPS < 20) or (CPS > (baud/5.0)) then
  1346.       begin
  1347.          Time := 0;     {don't consider aborted or invalid transfers}
  1348.          ideal := 0;
  1349. (***
  1350.          gotoxy(1,3);
  1351.          writeln('Download time out of range: CPS=',CPS:4:0,' Min=20 Max=',baud/5:0:0);
  1352.          writeln(urec);
  1353. ***)
  1354.       end
  1355.       else
  1356.          Time := size/CPS;
  1357.  
  1358.       {determine protocol and find table entry}
  1359.       posit := pos(' USING ', Urec);
  1360.       prot := Urec[posit+7];
  1361.  
  1362.       for k := 1 to ProtocolCount do
  1363.       with Protocol[k] do
  1364.  
  1365.          if (Code = prot) or (Code = '?') then
  1366.          begin
  1367.             if Code = '?' then
  1368.             begin
  1369.                gotoxy(1,3);
  1370.                writeln('Unknown protocol: ',Urec);
  1371.             end;
  1372.  
  1373.             if Urec[8] = 'D' then
  1374.             begin
  1375.                inc(Downloads);
  1376.                DownTime := DownTime+Time;
  1377.                DownIdeal := DownIdeal+ideal;
  1378.                inc(down);
  1379.             end
  1380.             else
  1381.             begin
  1382.                inc(Uploads);
  1383.                UpTime := UpTime+Time;
  1384.                UpIdeal := UpIdeal+ideal;
  1385.                inc(up);
  1386.             end;
  1387.  
  1388.             exit;
  1389.          end;
  1390.    end;
  1391.  
  1392.  
  1393. (* -------------------------------------------------------- *)
  1394. procedure confjoin;        {conferences joined}
  1395.    var
  1396.       posit:   integer;
  1397.       ConfName:  anystring;
  1398.  
  1399.    begin
  1400.       posit := pos(' CONFERENCE', Urec);
  1401.       if posit < 8 then
  1402.          exit;
  1403.  
  1404.       ConfName := copy(Inrec, 7, 10);
  1405.       posit := pos(' ',ConfName);
  1406.       if posit > 0 then
  1407.          ConfName[0] := chr(posit-1);
  1408.  
  1409.       case ConfName[1] of
  1410.          '0'..'9', 'a'..'z', 'A'..'Z':
  1411.          begin
  1412.             inc(joins);
  1413.             add_item(FirstConf, ConfName, 1);
  1414.          end;
  1415.       end;
  1416.    end;
  1417.  
  1418.  
  1419. (* -------------------------------------------------------- *)
  1420. procedure batch;        {batch transfer}
  1421.    var
  1422.       posit:   integer;
  1423.       num:     integer;
  1424.       BatchName:  anystring;
  1425.       temp:    anystring;
  1426.  
  1427.    begin
  1428.       posit := pos(' FILES', Urec);
  1429.       temp := copy(Urec,7,posit-7);
  1430.       num := 0;
  1431.       val(temp,num,posit);
  1432.       if num < 1 then
  1433.          exit;
  1434.       if Urec[posit+7] = '0' then
  1435.          exit;
  1436.  
  1437.       if num = 1 then
  1438.          BatchName := '  Single Files'
  1439.       else
  1440.          BatchName := itoa(num) + ' Files';
  1441.  
  1442.       batchs := batchs + num;
  1443.       add_item(FirstBatch, BatchName, num);
  1444.    end;
  1445.  
  1446.  
  1447. (* -------------------------------------------------------- *)
  1448. procedure zipmsgs;        {ziphived message count}
  1449.    var
  1450.       posit:   integer;
  1451.       num:     integer;
  1452.    
  1453.    begin
  1454.       posit := pos(' MESSA', Urec);
  1455.       num := 0;
  1456.       val(copy(Urec,7,posit-7),num,posit);
  1457.       if num < 1 then
  1458.          exit;
  1459.       msgcount := msgcount + num;
  1460.    end;
  1461.  
  1462.  
  1463. (* -------------------------------------------------------- *)
  1464. var
  1465.    numdays:  integer;
  1466.  
  1467. function finday(Days:  integer):  integer;
  1468.    begin
  1469.       case Days of
  1470.         12:  numdays := 334;
  1471.         11:  numdays := 304;
  1472.         10:  numdays := 273;
  1473.          9:  numdays := 243;
  1474.          8:  numdays := 212;
  1475.          7:  numdays := 181;
  1476.          6:  numdays := 151;
  1477.          5:  numdays := 120;
  1478.          4:  numdays := 90;
  1479.          3:  numdays := 59;
  1480.          2:  numdays := 31;
  1481.          1:  numdays := 0;
  1482.       end;                 {case}
  1483.       finday := numdays;
  1484.    end;
  1485.  
  1486.  
  1487. (* -------------------------------------------------------- *)
  1488. procedure bulletins;
  1489.    var
  1490.       posit:      integer;
  1491.       BltNumber:  anystring;
  1492.       BltName:    anystring;
  1493.  
  1494.    begin
  1495.       BltName := copy(Inrec, 22, 10);
  1496.       posit := pos(' ', BltName);
  1497.       if posit > 0 then
  1498.          BltName[0] := chr(posit-1);
  1499.       if length(BltName) = 0 then
  1500.          exit;
  1501.  
  1502.       posit := pos('#', Inrec);
  1503.       if posit = 0 then
  1504.          exit;
  1505.       BltNumber := copy(Inrec,posit+2,4);
  1506.       posit := pos(' ', BltNumber);
  1507.       if posit > 0 then
  1508.          BltNumber[0] := chr(posit-1);
  1509.       while length(BltNumber) < 3 do
  1510.          BltNumber := ' ' + BltNumber;
  1511.  
  1512.       BltName := BltName + ' #' + BltNumber;
  1513.       inc(blts);
  1514.       add_item(FirstBullet, BltName, 1);
  1515.    end;                    {bulletins}
  1516.  
  1517.  
  1518. (* -------------------------------------------------------- *)
  1519. procedure sec_level;
  1520.    var
  1521.       Name: anystring;
  1522.       p: integer;
  1523.    begin
  1524.       p := pos(':',Inrec);
  1525.       if p = 0 then exit;
  1526.       Name := copy(Inrec,p+1,19);
  1527.       while Name[length(Name)] = ' ' do
  1528.          dec(Name[0]);
  1529.       while copy(Name,1,1) = ' ' do
  1530.          delete(Name,1,1);
  1531.       if Name = '' then exit;
  1532.  
  1533.       while length(Name) < 3 do
  1534.          Name := ' ' + Name;
  1535.       Name := 'Level '+Name;
  1536.       add_item(FirstSecLevel, Name, 1);
  1537.       clevel := Name;
  1538.    end;
  1539.  
  1540.  
  1541. (* -------------------------------------------------------- *)
  1542. procedure con_type;
  1543.    var
  1544.       Name: anystring;
  1545.  
  1546.    begin          {......Connect Type: xxxx}
  1547.       Name := copy(Inrec,21,255);
  1548.       while Name[length(name)] = ' ' do
  1549.          dec(Name[0]);
  1550.       add_item(FirstConType, Name, 1);
  1551.    end;
  1552.  
  1553.  
  1554. (* -------------------------------------------------------- *)
  1555. procedure pfree_down;
  1556.    var
  1557.       Name: anystring;
  1558.  
  1559.    begin          {......Free Download: xxxx}
  1560.       Name := copy(Inrec,22,12);
  1561.       add_item(FirstFreeDL, Name, 1);
  1562.       inc(free_down)
  1563.    end;
  1564.  
  1565.  
  1566. (* -------------------------------------------------------- *)
  1567. procedure pdoors;
  1568.    var
  1569.       posit:      integer;
  1570.       DoorName:   string[40];
  1571.  
  1572.    begin
  1573.       if pos(' AT ', Urec) = 0 then exit;
  1574.  
  1575.       posit := pos('(', Inrec);
  1576.       if posit = 0 then exit;
  1577.  
  1578.       DoorName := copy(Inrec, posit+1, pos(')', Inrec)-posit-1);
  1579.       repeat
  1580.          posit := pos('\',DoorName);
  1581.          if posit > 0 then
  1582.             DoorName := copy(DoorName, posit+1, 99);
  1583.       until posit = 0;
  1584.  
  1585.       inc(DOORs);
  1586.       add_item(FirstDoor, DoorName, 1);
  1587.    end;
  1588.  
  1589.  
  1590. (* -------------------------------------------------------- *)
  1591. procedure DOSdrop;
  1592.    var
  1593.       DT1, DT2:   integer;
  1594.       a:          integer;
  1595.  
  1596.    begin
  1597.       val(copy(Urec, 34, 2), DT1, a); {exit to DOS time}
  1598.  
  1599.       getrec;
  1600.       val(copy(Urec, 27, 2), DT2, a); {back from DOS time}
  1601.       if a = 0 then 
  1602.       begin
  1603.          DT1 := (DT2-DT1);
  1604.          if DT1 < 0 then DT1 := DT1+60; {adjust for hour rollover}
  1605.          DosTime := DosTime+DT1;
  1606.       end;
  1607.       inc(DosTimes);
  1608.    end;
  1609.  
  1610.  
  1611. (* -------------------------------------------------------- *)
  1612. procedure sysop_chat;
  1613.    var
  1614.       DT1, DT2:   integer;
  1615.       a:          integer;
  1616.       node:       boolean;
  1617.  
  1618.    begin
  1619.       node := (Urec[7] = 'N');
  1620.       val(copy(Urec, 34, 2), DT1, a); {chat started time time}
  1621.  
  1622.       getrec;
  1623.       val(copy(Urec, 27, 2), DT2, a); {chat ended time}
  1624.       if a = 0 then 
  1625.       begin
  1626.          DT1 := (DT2-DT1);
  1627.          if DT1 < 0 then DT1 := DT1+60; {adjust for hour rollover}
  1628.       end;
  1629.  
  1630.       if node then
  1631.          inc(nchat)
  1632.       else
  1633.          inc(schat);
  1634.    end;
  1635.  
  1636.  
  1637. (* -------------------------------------------------------- *)
  1638. procedure system_event;
  1639.    var
  1640.       p: integer;
  1641.    begin
  1642.       p := pos(':',urec);
  1643.       if p > 0 then
  1644.          event_time := copy(urec,p-2,5)
  1645.       else
  1646.          event_time := '';
  1647.       inc(events);
  1648.    end;
  1649.  
  1650.  
  1651. (* -------------------------------------------------------- *)
  1652. procedure mins_used;
  1653.    var
  1654.       a, y, p:  integer;
  1655.       minutoff,
  1656.       houroff,
  1657.       timeused:  integer;
  1658.  
  1659.    begin
  1660.       p := pos(':', Urec)+2;
  1661.       y := p;
  1662.       while (Urec[y] >= '0') and (Urec[y] <= '9') do
  1663.          inc(y);
  1664.       val(copy(Urec, p, y-p), timeused, a);
  1665.  
  1666.       if clevel <> '' then
  1667.       begin
  1668.          add_item(FirstAveMins, clevel, timeused/60.0);
  1669.          clevel := '';
  1670.       end;
  1671.  
  1672.       getrec;
  1673.       val(copy(Urec, 11, 2), houroff, a);
  1674.       if houroff > 23 then
  1675.          houroff := houroff - 24;
  1676.       val(copy(Urec, 14, 2), minutoff, a);
  1677.  
  1678.       while timeused > 0 do
  1679.       begin
  1680.          if timeused > minutoff then
  1681.             a := minutoff
  1682.          else
  1683.             a := timeused;
  1684.  
  1685.          UsedMinutes := UsedMinutes + a;
  1686.          while UsedMinutes > 60 do
  1687.          begin
  1688.             inc(Hours);
  1689.             UsedMinutes := UsedMinutes - 60;
  1690.          end;
  1691.  
  1692.          Hrs[houroff] := Hrs[houroff]+a;
  1693.          timeused := timeused-a;
  1694.  
  1695.          if houroff > 0 then
  1696.             dec(houroff)
  1697.          else
  1698.             houroff := 23;
  1699.          minutoff := 60;
  1700.       end;
  1701.    end;
  1702.  
  1703.  
  1704. (* -------------------------------------------------------- *)
  1705. procedure catchall;
  1706.    begin
  1707.       if pos(' CHAT ', Urec)              > 0 then sysop_chat
  1708.       else if pos('SCHEDULED', Urec)      > 0 then system_event
  1709.       else if pos('OPENED DOOR ', Urec)   > 0 then pdoors
  1710.       else if pos('OINED', Urec)          > 0 then confjoin
  1711.       else if pos('MINUTES USED', Urec)   > 0 then mins_used
  1712.       else if pos('ACCESS DENIED', Urec)  > 0 then inc(tcan)
  1713.       else if pos('COMMENT ', Urec)       > 0 then inc(comments)
  1714.       else if pos('NOT REGISTERED', Urec) > 0 then inc(secviol)
  1715.       else if pos('OCK-', Urec)           > 0 then inc(lockouts)
  1716.       else if pos('PAGED', Urec)          > 0 then inc(sysop_paged)
  1717.       else if pos('QUESTIONNAIRE ', Urec) > 0 then inc(question)
  1718.       else if pos('REFUSED', Urec)        > 0 then inc(refused)
  1719.       else if pos('TIME LIMIT', Urec)     > 0 then inc(time_limit)
  1720.       else if pos('VIOLATION', Urec)      > 0 then inc(secviol)
  1721.       else if pos('LEFT:', Urec)          > 0 then inc(mssgs)
  1722.    end;
  1723.  
  1724.  
  1725. (* -------------------------------------------------------- *)
  1726. procedure scanrec;
  1727.    begin
  1728.  
  1729.       if Urec[1] <> ' ' then
  1730.          incaller
  1731.       else
  1732.  
  1733.       case Urec[7] of
  1734.          '*' :;
  1735.  
  1736.          '(':  if Urec[9] <> ')' then inc(stuff)
  1737.                else if Urec[8] = 'D' then indownload
  1738.                else if Urec[8] = 'U' then indownload
  1739.                else catchall;
  1740.  
  1741.          'A':  if pos('ACCESS DENIED', Urec)       > 0 then inc(tcan)
  1742.                else catchall;
  1743.  
  1744.          'B':  if pos('BULLETIN READ:', Urec)      > 0 then bulletins
  1745.                else if pos('BACK FROM DOS', Urec)  > 0 then inc(backdos)
  1746.                else catchall;
  1747.  
  1748.          'C':  if pos('COMMENT ', Urec)            > 0 then inc(comments)
  1749.                else if pos('CALLER EXITED ', Urec) > 0 then DOSdrop
  1750.                else if pos('CONNECT TYPE:',Urec)   > 0 then con_type
  1751.                else if pos('CALLER SECURITY',Urec) > 0 then sec_level
  1752.                else catchall;
  1753.  
  1754.          'D':  if pos('DIRECTORY SCAN ', Urec)     > 0 then inc(dirscan)
  1755.                else catchall;
  1756.  
  1757.          'E':  if pos('EXTRACT M', Urec)           > 0 then inc(extmember)
  1758.                else catchall;
  1759.  
  1760.          'F':  if pos('FILE (', Urec)              > 0 then inc(stuff)
  1761.                else if pos('FREE DOWNLOAD', Urec)  > 0 then pfree_down
  1762.                else catchall;
  1763.  
  1764.          'K':  if pos('KEYBOARD TIME',Urec)        > 0 then inc(stuff)
  1765.                else catchall;
  1766.  
  1767.          'I':  if pos('INSUFFICIENT ',Urec)        > 0 then inc(secviol)
  1768.                else if pos('INVALID ARC',Urec)     > 0 then inc(invalids)
  1769.                else if pos('INVALID ZIP',Urec)     > 0 then inc(invalids)
  1770.                else if pos('INVALID FIL',Urec)     > 0 then inc(invalids)
  1771.                else catchall;
  1772.  
  1773.          'M':  if pos('LEFT:', Urec)               > 0 then
  1774.                begin
  1775.                   inc(mssgs);
  1776.                   if pos('VIA QMAIL', Urec) > 0 then
  1777.                      inc(Qmssgs);
  1778.                   if pos('THRU MARKM', Urec) > 0 then
  1779.                      inc(Mmssgs);
  1780.                end
  1781.                else if pos('KILLED:', Urec)        > 0 then inc(kills)
  1782.                else if pos('MINUTES USED', Urec)   > 0 then mins_used
  1783.                else catchall;
  1784.  
  1785.          'N':  if pos('NODE CHAT ENT', Urec)       > 0 then sysop_chat
  1786.                else if pos('NODE CHAT END', Urec)  > 0 then inc(stuff)
  1787.                else catchall;
  1788.  
  1789.          'O':  if pos('OPERATOR', Urec)            > 0 then inc(sysop_paged)
  1790.                else if pos('OPENED DOOR ', Urec)   > 0 then pdoors
  1791.                else catchall;
  1792.  
  1793.          'P':  if pos('PASSWORD FAILURE', Urec)    > 0 then inc(pwfail)
  1794.                else catchall;
  1795.  
  1796.          'R':  if pos('REFUSED', Urec)             > 0 then inc(refused)
  1797.                else if pos('REGISTRATION', Urec)   > 0 then inc(new_guys)
  1798.                else if pos('REPACK ', Urec)        > 0 then inc(repacks)
  1799.                else if pos('REQUEST LIBRARY',Urec) > 0 then inc(libdisk)
  1800.                else catchall;
  1801.  
  1802.          'S':  if pos('SCHEDULED', Urec)           > 0 then system_event
  1803.                else if pos('SORRY', Urec)          > 0 then inc(secviol)
  1804.                else if pos('SYSOP CHAT A', Urec)   > 0 then sysop_chat
  1805.                else if pos('SYSOP CHAT E', Urec)   > 0 then inc(stuff)
  1806.                else if pos('SECURITY LEVEL:',Urec) > 0 then sec_level
  1807.                else catchall;
  1808.  
  1809.          'T':  if pos('TIME LIMIT', Urec)          > 0 then inc(time_limit)
  1810.                else if pos('REGISTRATION', Urec)   > 0 then inc(new_guys)
  1811.                else if pos('TEST EXECUTED', Urec)  > 0 then inc(testexec)
  1812.                else if pos('THANKS, ', Urec)       > 0 then inc(secviol)
  1813.                else catchall;
  1814.  
  1815.          'V':  if pos('VIEW E', Urec)              = 7 then inc(viewexec)
  1816.                else if pos('VIEW M', Urec)         = 7 then inc(viewmember)
  1817.                else catchall;
  1818.  
  1819.          'Z':  if pos('ZIPM EXE', Urec)            > 0 then inc(zipmail)
  1820.                else catchall;
  1821.  
  1822.          '0'..'9':
  1823.                if pos(' FILES,',Urec)              > 0 then batch
  1824.                else if pos(' MESSAGES ',Urec)      > 0 then zipmsgs
  1825.                else catchall;
  1826.          else
  1827.                catchall;
  1828.       end;
  1829.    end;
  1830.  
  1831.  
  1832. (* -------------------------------------------------------- *)
  1833. function rec_time(rec: anystring): anystring;
  1834. var
  1835.    temp: anystring;
  1836.  
  1837. begin      {12345678901234}
  1838.            {yy-mm-dd hh:mm};
  1839.    temp := '00-00-00 00:00';
  1840.  
  1841.    if length(rec) > 15 then
  1842.    begin
  1843.       temp[1] := rec[7];
  1844.       temp[2] := rec[8];
  1845.  
  1846.       temp[4] := rec[1];
  1847.       temp[5] := rec[2];
  1848.  
  1849.       temp[7] := rec[4];
  1850.       temp[8] := rec[5];
  1851.  
  1852.       temp[10] := rec[11];
  1853.       temp[11] := rec[12];
  1854.       temp[13] := rec[14];
  1855.       temp[14] := rec[15];
  1856.    end;
  1857.  
  1858.    rec_time := temp;
  1859. end;
  1860.  
  1861.  
  1862. (* -------------------------------------------------------- *)
  1863. procedure jdate(rec: string; var dt: real);
  1864. var
  1865.    a,mostr,daystr,yrstr:   word;
  1866.    frac:                   real;
  1867.    days:                   real;
  1868.    hours:                  real;
  1869.  
  1870. begin
  1871.    {12345678901234}
  1872.    {yy-mm-dd hh:mm}
  1873.  
  1874.    val( copy(rec, 4, 2), mostr, a);   {get month}
  1875.    days := finday(mostr);
  1876.  
  1877.    val(copy(rec, 7, 2), daystr, a);   {get day}
  1878.  
  1879.    val(rec[2], YrStr, a);             {last digit of year}
  1880.    if YrStr < 8 then
  1881.       inc(YrStr,10);
  1882.  
  1883.    val(copy(rec, 10, 2), hours, a);   {hour digit of logon}
  1884.    if hours > 23 then
  1885.       hours := hours - 24;
  1886.  
  1887.    val(copy(rec, 13, 2), frac, a);
  1888.    frac := frac/60;
  1889.  
  1890.    dt := hours + (yrstr*365+days+daystr) * 24 + frac;
  1891. end;
  1892.  
  1893.  
  1894. (* -------------------------------------------------------- *)
  1895. procedure scanfile(node: integer);
  1896.    var
  1897.       tx1:     string[20];
  1898.       tx:      anystring;
  1899.       nrec:    word;
  1900.  
  1901.    begin
  1902.       nrec := 0;
  1903.  
  1904.       while not eof(ifd) do
  1905.       begin
  1906.          scanrec;
  1907.  
  1908.          inc(nrec);
  1909.          if (nrec mod 50) = 1 then
  1910.          begin
  1911.             str((int(nrec)/int(logsize)*100.0):  5:  1, tx1);
  1912.             tx1 := 'Working ... '+tx1+' %';
  1913.             print(2, 17, tx1, ansicrt.lightred);
  1914.          end;
  1915.  
  1916.          getrec;
  1917.       end;
  1918.  
  1919.       close(ifd);
  1920.  
  1921.       tx1 := 'Working ... 100.0 %';
  1922.       print(2, 17, tx1, ansicrt.cyan);
  1923.  
  1924.       if rec_time(last_rec_seen) > rec_time(last_rec) then
  1925.          last_rec := last_rec_seen;
  1926.       last_entry := rec_time(last_rec);
  1927.       print(2, 23, 'Last log entry:  '+last_rec, ansicrt.lightgreen);
  1928.       jdate(last_entry,end_hours);
  1929.  
  1930.       {determine the period involved}
  1931.       PeriodCovered := 'Period covered:  From '+first_entry+' to '+last_entry;
  1932.       print(2, 21, PeriodCovered, ansicrt.lightmagenta);
  1933.  
  1934.       if node = nodes then
  1935.       begin
  1936.          TotHours := (end_hours-beg_hours) * nodes;
  1937.          str(TotHours:  5:  1, TX);
  1938.          TX := concat('Total Hours of Operation: ', TX);
  1939.          print(2, 19, TX, ansicrt.white);
  1940.       end;
  1941.    end;
  1942.  
  1943.  
  1944. (* -------------------------------------------------------- *)
  1945. procedure openfiles(node: integer);
  1946.    var
  1947.       TX:   string[62];
  1948.       name: anystring;
  1949.       a:    integer;
  1950.       fd:   dos_handle;
  1951.  
  1952.    begin
  1953.       stoupper(inName);
  1954.       if (node > 0) and (inName <> 'NUL') then
  1955.          TX := itoa(node)
  1956.       else
  1957.          TX := '';
  1958.       name := InName + TX;
  1959.  
  1960.       if name <> 'NUL' then
  1961.          print(1,1,'Reading '+name+' ...',ansicrt.white);
  1962.       clreol;
  1963.  
  1964.       fd := dos_open(name,open_read);
  1965.       if ioresult = dos_error then
  1966.       begin
  1967.          writeln('Cant open caller file: ',name);
  1968.          halt(1);
  1969.       end;
  1970.  
  1971.       dos_lseek(fd,0,seek_end);
  1972.       logsize := dos_tell div 64;
  1973.       dos_close(fd);
  1974.  
  1975.       TX := 'Total Records in the Callers file: '+wtoa(logsize);
  1976.       print(2, 20, TX, ansicrt.yellow);
  1977.  
  1978.       assignText(ifd,name);
  1979.       {$i-} reset(ifd); {$i+}
  1980.       if ioresult <> 0 then
  1981.       begin
  1982.          writeln('Cant open caller file: ',name);
  1983.          halt(1);
  1984.       end;
  1985.  
  1986.       SetTextbuf(ifd,iobuf);
  1987.  
  1988.       {decode the beginning of the logfile}
  1989.       repeat
  1990.          getrec;
  1991.       until (Urec[3] = '-') or eof(ifd);
  1992.  
  1993.       if (not eof(ifd)) then
  1994.          if (first_rec = '') or (rec_time(first_rec) > rec_time(Urec)) then
  1995.             first_rec := Urec;
  1996.  
  1997.       first_entry := rec_time(first_rec);
  1998.       print(2, 22, 'First log entry: '+first_rec, ansicrt.lightgreen);
  1999.  
  2000.       jdate(first_entry,beg_hours);
  2001.    end;
  2002.  
  2003.  
  2004.  
  2005. (* -------------------------------------------------------- *)
  2006. var
  2007.    line: string;
  2008.    xfd: text;
  2009.  
  2010. procedure write_list(node: ItemPointer);
  2011. begin
  2012.    while node <> nil do
  2013.    begin
  2014.       writeln(xfd,node^.name);
  2015.       writeln(xfd,node^.count);
  2016.       node := node^.next;
  2017.    end;
  2018.    writeln(xfd);
  2019. end;
  2020.  
  2021.  
  2022. (* -------------------------------------------------------- *)
  2023. procedure write_tree(node: FilePointer);
  2024. begin
  2025.    if node = nil then
  2026.       writeln(xfd)
  2027.    else
  2028.    begin
  2029.       writeln(xfd,node^.name);
  2030.       writeln(xfd,node^.size,' ',node^.count);
  2031.       write_tree(node^.higher);
  2032.       write_tree(node^.lower);
  2033.    end;
  2034. end;
  2035.  
  2036.  
  2037. (* -------------------------------------------------------- *)
  2038. procedure read_list(var node: ItemPointer);
  2039. var
  2040.    add:  ItemPointer;
  2041.  
  2042. begin
  2043.    {special case - empty list}
  2044.    Qreadln(xfd,line,sizeof(line));
  2045.    repeat
  2046.       if length(line) = 0 then
  2047.       begin
  2048.          node := nil;
  2049.          exit;
  2050.       end;
  2051.       if line[1] = ' ' then
  2052.          delete(line,1,1);
  2053.    until line[1] <> ' ';
  2054.  
  2055.    {insert head of list}
  2056.    new(node);
  2057.    add := node;
  2058.    add^.name := line;
  2059.    readln(xfd,add^.count);
  2060.  
  2061.    {add rest of the list}
  2062.    Qreadln(xfd,line,sizeof(line));
  2063.    while length(line) <> 0 do
  2064.    begin
  2065.       new(add^.next);
  2066.       add := add^.next;
  2067.       add^.name := line;
  2068.       readln(xfd,add^.count);
  2069.  
  2070.       Qreadln(xfd,line,sizeof(line));
  2071.    end;
  2072.  
  2073.    add^.next := nil;
  2074. end;
  2075.  
  2076.  
  2077. (* -------------------------------------------------------- *)
  2078. procedure read_tree(var node: FilePointer);
  2079. begin
  2080.    Qreadln(xfd,line,sizeof(line));
  2081.    if length(line)=0 then
  2082.       node := nil
  2083.    else
  2084.    begin
  2085.       new(node);
  2086.       node^.name := line;
  2087.       read(xfd,node^.size);
  2088.       readln(xfd,node^.count);
  2089.       read_tree(node^.higher);
  2090.       read_tree(node^.lower);
  2091.    end;
  2092. end;
  2093.  
  2094.  
  2095. (* -------------------------------------------------------- *)
  2096. procedure save_state;
  2097. var
  2098.    i: integer;
  2099.  
  2100. begin
  2101.    stoupper(saveFile);
  2102.    if saveFile = 'NUL' then
  2103.       exit;
  2104.  
  2105.    print(1,1,'Writing '+saveFile+' ...',ansicrt.white);
  2106.    clreol;
  2107.  
  2108.    assign(xfd,saveFile);
  2109.    rewrite(xfd);
  2110.    SetTextbuf(xfd,iobuf);
  2111.  
  2112.    writeln(xfd,'-7');
  2113.  
  2114.    writeln(xfd,spare1);
  2115.    writeln(xfd,spare2);
  2116.    writeln(xfd,spare3);
  2117.    writeln(xfd,spare4);
  2118.    writeln(xfd,event_mins);
  2119.    writeln(xfd,event_time);
  2120.  
  2121.    writeln(xfd,copy(last_rec,1,62));
  2122.  
  2123.    writeln(xfd,
  2124.            Qmssgs,' ',
  2125.            libdisk,' ',
  2126.            spare13);
  2127.  
  2128.    writeln(xfd,
  2129.            zipmail,' ',
  2130.            msgcount,' ',
  2131.            invalids,' ',
  2132.            spare6,' ',
  2133.            spare7,' ',
  2134.            spare8,' ',
  2135.            nchat,' ',
  2136.            spare9,' ',
  2137.            testexec,' ',
  2138.            free_down);
  2139.  
  2140.    writeln(xfd,
  2141.            viewexec,' ',
  2142.            spare15,' ',
  2143.            spare11,' ',
  2144.            spare14,' ',
  2145.            spare16,' ',
  2146.            spare12,' ',
  2147.            backdos,' ',
  2148.            batchs);
  2149.  
  2150.    writeln(xfd,
  2151.            Mmssgs,' ',
  2152.            blts,' ',
  2153.            caller,' ',
  2154.            schat,' ',
  2155.            comments,' ',
  2156.            dirscan,' ',
  2157.            DOORs,' ',
  2158.            DosTime);
  2159.  
  2160.    writeln(xfd,
  2161.            DosTimes,' ',
  2162.            down,' ',
  2163.            d_abort,' ',
  2164.            events,' ',
  2165.            even_parity,' ',
  2166.            extmember,' ',
  2167.            graphics,' ',
  2168.            Hours);
  2169.  
  2170.    writeln(xfd,
  2171.            joins,' ',
  2172.            kills,' ',
  2173.            lockouts,' ',
  2174.            UsedMinutes,' ',
  2175.            mssgs,' ',
  2176.            new_guys,' ',
  2177.            non_graphics,' ',
  2178.            sysop_paged);
  2179.  
  2180.    writeln(xfd,
  2181.            pwfail,' ',
  2182.            question,' ',
  2183.            repacks,' ',
  2184.            refused,' ',
  2185.            secviol,' ',
  2186.            stuff,' ',
  2187.            sysop_local,' ',
  2188.            sysop_remote);
  2189.  
  2190.    writeln(xfd,
  2191.            tcan,' ',
  2192.            time_limit,' ',
  2193.            TotHours:0:2,' ',
  2194.            UniqFiles,' ',
  2195.            up,' ',
  2196.            u_abort,' ',
  2197.            viewmember);
  2198.  
  2199.    writeln(xfd,copy(first_rec,1,62));
  2200.  
  2201.    for i := 1 to ProtocolCount do
  2202.    with Protocol[i] do
  2203.       writeln(xfd,
  2204.                  code,' ',
  2205.                  Uploads,' ',
  2206.                  UpTime:0:2,' ',
  2207.                  UpIdeal:0:2,' ',
  2208.                  Downloads,' ',
  2209.                  DownTime:0:2,' ',
  2210.                  DownIdeal:0:2);
  2211.  
  2212.    for i := 0 to 23 do
  2213.       writeln(xfd,Hrs[i]);
  2214.  
  2215.    write_list(FirstAvemins);
  2216.    write_list(FirstSpare3);
  2217.    write_list(FirstSpare4);
  2218.    write_list(FirstSpare5);
  2219.    write_list(FirstSpare6);
  2220.    write_list(FirstSpare7);
  2221.    write_list(FirstSpare8);
  2222.  
  2223.    write_list(FirstFreeDL);
  2224.    write_list(FirstConType);
  2225.    write_list(FirstSecLevel);
  2226.    write_list(FirstBaud);
  2227.    write_list(FirstBatch);
  2228.    write_list(FirstBullet);
  2229.    write_list(FirstConf);
  2230.    write_list(FirstDoor);
  2231.  
  2232.    write_tree(FileTree);
  2233.  
  2234.    close(xfd);
  2235. end;
  2236.  
  2237.  
  2238. (* -------------------------------------------------------- *)
  2239. procedure load_state;
  2240. var
  2241.    i: integer;
  2242.    n: integer;
  2243.    c: char;
  2244.  
  2245. begin
  2246.    assign(xfd,saveFile);
  2247.    {$i-} reset(xfd); {$i+}
  2248.    if ioresult <> 0 then
  2249.       exit;
  2250.  
  2251.    SetTextbuf(xfd,iobuf);
  2252.    print(1,1,'Loading '+saveFile+' ...',ansicrt.white);
  2253.    clreol;
  2254.  
  2255.    read(xfd,filever);
  2256.    if (filever <> -6) and (filever <> -7) then
  2257.    begin
  2258.       writeln('Can''t use your old ',saveFile,' file!  Will create a new one.');
  2259.       close(xfd);
  2260.       exit;
  2261.    end;
  2262.  
  2263.    readln(xfd, spare1);
  2264.    readln(xfd, spare2);
  2265.    readln(xfd, spare3);
  2266.    readln(xfd, spare4);
  2267.    readln(xfd, event_mins);
  2268.    readln(xfd, event_time);
  2269.  
  2270.    Qreadln(xfd,last_rec,sizeof(last_rec));
  2271.  
  2272.    read(xfd, Qmssgs, libdisk, spare13, zipmail, msgcount, invalids,
  2273.            spare6, spare7, spare8, nchat, spare9, testexec, free_down,
  2274.            viewexec, spare15, spare11, spare14, spare16, spare12,
  2275.            backdos, batchs, Mmssgs, blts, caller, schat, comments,
  2276.            dirscan, DOORs, DosTime, DosTimes, down, d_abort, events,
  2277.            even_parity, extmember, graphics, Hours, joins, kills,
  2278.            lockouts, UsedMinutes, mssgs, new_guys, non_graphics,
  2279.            sysop_paged, pwfail, question, repacks, refused, secviol,
  2280.            stuff, sysop_local, sysop_remote, tcan, time_limit, TotHours,
  2281.            UniqFiles, up, u_abort);
  2282.  
  2283.    readln(xfd, viewmember);
  2284.  
  2285.    Qreadln(xfd,first_rec,sizeof(first_rec));
  2286.  
  2287.    if filever = -6 then
  2288.       n := OldProtocolCount
  2289.    else
  2290.       n := ProtocolCount;
  2291.    for i := 1 to n do
  2292.    with Protocol[i] do
  2293.       readln(xfd, code, Uploads, UpTime, UpIdeal,
  2294.                         Downloads, DownTime, DownIdeal);
  2295.  
  2296.    for i := 0 to 23 do
  2297.       readln(xfd,Hrs[i]);
  2298.  
  2299.    read_list(FirstAvemins);
  2300.  
  2301.    read_list(FirstSpare3);
  2302.    read_list(FirstSpare4);
  2303.    read_list(FirstSpare5);
  2304.    read_list(FirstSpare6);
  2305.    read_list(FirstSpare7);
  2306.    read_list(FirstSpare8);
  2307.  
  2308.    read_list(FirstFreeDL);
  2309.    read_list(FirstConType);
  2310.    read_list(FirstSecLevel);
  2311.  
  2312.    read_list(FirstBaud);
  2313.    read_list(FirstBatch);
  2314.    read_list(FirstBullet);
  2315.    read_list(FirstConf);
  2316.    read_list(FirstDoor);
  2317.  
  2318.    read_tree(FileTree);
  2319.  
  2320.    close(xfd);
  2321.  
  2322.    write(^M);
  2323.    clreol;
  2324. end;
  2325.  
  2326.  
  2327. (* -------------------------------------------------------- *)
  2328. procedure usage;
  2329. begin
  2330.    writeln('Usage:   calls CONFIG_FILE');
  2331.    writeln('Example: calls calls.cnf');
  2332.    halt;
  2333. end;
  2334.  
  2335.  
  2336. (* -------------------------------------------------------- *)
  2337. procedure clean(var s: anystring);
  2338. begin
  2339.    while s[length(s)] = ' ' do
  2340.       dec(s[0]);         {skip trailing blanks}
  2341.    while copy(s,1,1) = ' ' do
  2342.       delete(s,1,1);     {skip leading blanks}
  2343. end;
  2344.  
  2345.  
  2346. (* -------------------------------------------------------- *)
  2347. procedure define_protocol(par: anystring);
  2348. var
  2349.    k: integer;
  2350. begin
  2351.       for k := 1 to ProtocolCount do
  2352.       with Protocol[k] do
  2353.          if (Code = par[1]) then
  2354.             name := copy(par,3,255);
  2355. end;
  2356.  
  2357.  
  2358. (* -------------------------------------------------------- *)
  2359. procedure set_event_mode(par: anystring);
  2360. begin
  2361.    if (par = 'OFF') or (par = 'BUSY') or (par = 'IDLE') then
  2362.       event_mode := par
  2363.    else
  2364.    begin
  2365.       writeln('Invalid EVENTMODE parameter: ',par);
  2366.       writeln('Must be one of:  OFF BUSY IDLE');
  2367.       halt(1);
  2368.    end;
  2369. end;
  2370.  
  2371.  
  2372. (* -------------------------------------------------------- *)
  2373. procedure load_configuration;
  2374. var
  2375.    fd:   text;
  2376.    cmd:  anystring;
  2377.    par:  anystring;
  2378.    p:    integer;
  2379.  
  2380. begin
  2381.    if paramcount < 1 then
  2382.       usage;
  2383.  
  2384.    assignText(fd,paramstr(1));
  2385.    {$i-} reset(fd); {$i+}
  2386.    if ioresult <> 0 then
  2387.    begin
  2388.       writeln('Can''t open config file: ',paramstr(1));
  2389.       halt;
  2390.    end;
  2391.  
  2392.    while not eof(fd) do
  2393.    begin
  2394.       readln(fd,cmd);
  2395.  
  2396.       p := pos(';',cmd);      {skip       ;comments}
  2397.       if p > 0 then
  2398.          cmd[0] := chr(p-1);
  2399.  
  2400.       clean(cmd);
  2401.  
  2402.       p := pos(' ',cmd);
  2403.       if p = 0 then
  2404.          par := ''
  2405.       else
  2406.       begin
  2407.          par := copy(cmd,p+1,255);
  2408.          cmd[0] := chr(p-1);
  2409.          clean(cmd);
  2410.          clean(par);
  2411.       end;
  2412.  
  2413.       stoupper(cmd);
  2414.  
  2415.       if (cmd = 'INFILE')        then  inName := par
  2416.  
  2417.       else if (cmd = 'OUTFILE')  then  outFile := par
  2418.  
  2419.       else if (cmd = 'SAVEFILE') then  saveFile := par
  2420.  
  2421.       else if (cmd = 'NODES')    then  val(par,nodes,p)
  2422.  
  2423.       else if (cmd = 'REPORTS')  then  reports := par
  2424.  
  2425.       else if (cmd = 'MINDL')    then  val(par,min_download,p)
  2426.  
  2427.       else if (cmd = 'PEAK')     then  PeakTable := par
  2428.  
  2429.       else if (cmd = 'MAXCONF')  then  val(par,maxConf,p)
  2430.  
  2431.       else if (cmd = 'MAXBLT')   then  val(par,maxBlt,p)
  2432.  
  2433.       else if (cmd = 'MAXDOOR')  then  val(par,maxDoor,p)
  2434.  
  2435.       else if (cmd = 'MAXBATCH') then  val(par,maxBatch,p)
  2436.  
  2437.       else if (cmd = 'MAXFREE')  then  val(par,maxFree,p)
  2438.  
  2439.       else if (cmd = 'PROTOCOL') then  define_protocol(par)
  2440.  
  2441.       else if (cmd = 'EVENTMODE') then set_event_mode(par)
  2442.  
  2443.       else if (cmd <> '') then
  2444.       begin
  2445.          writeln('Invalid config keyword: ',cmd,' ',par);
  2446.          writeln;
  2447.          writeln('Each config line must start with one of these words:');
  2448.          writeln('   INFILE OUTFILE SAVEFILE NODES REPORTS MINDL PEAK');
  2449.          writeln('   MAXCONF MAXBLT MAXDOOR MAXBATCH PROTOCOL EVENTMODE');
  2450.          halt(1);
  2451.       end;
  2452.    end;
  2453.  
  2454.    stoupper(inName);
  2455.    close(fd);
  2456. end;
  2457.  
  2458.  
  2459. (* -------------------------------------------------------- *)
  2460. procedure init;            {initialize}
  2461.    begin
  2462.       runtime := 0;
  2463.       start_time := Time;
  2464.  
  2465.       load_configuration;
  2466.  
  2467.       clrscr;
  2468.       print(13,  5, '╔═════════════════════════════════════════════════════╗', lightred);
  2469.       print(13,  6, '║                                                     ║', lightred);
  2470.       print(13,  7, '║                                                     ║', lightred);
  2471.       print(13,  8, '║                                                     ║', lightred);
  2472.       print(13,  9, '║                                                     ║', lightred);
  2473.       print(13, 10, '║                                                     ║', lightred);
  2474.       print(13, 11, '║                                                     ║', lightred);
  2475.       print(13, 12, '║                                                     ║', lightred);
  2476.       print(13, 13, '║                                                     ║', lightred);
  2477.       print(13, 14, '║                                                     ║', lightred);
  2478.       print(13, 15, '╚═════════════════════════════════════════════════════╝', lightred);
  2479.  
  2480.       print(32, 7, pcbversion, lightgreen);
  2481.       print(25, 9,  '     Calls v'+version+', '+reldate, lightgreen);
  2482.       print(25, 11, '     (c) 1987  Warren Lauzon', lightcyan);
  2483.       print(25, 12, '   Supported by Samuel H. Smith',ansicrt.white );
  2484.       print(25, 13, 'and The Tool Shop BBS 818/891-6780', ansicrt.white);
  2485.       gotoxy(1,1);
  2486.    end;
  2487.  
  2488.  
  2489. (* -------------------------------------------------------- *)
  2490. var
  2491.    node: integer;
  2492.  
  2493. begin
  2494.    init;
  2495.    load_state;
  2496.  
  2497.    if nodes = 1 then
  2498.    begin
  2499.       openfiles(0);
  2500.       scanfile(1);
  2501.    end
  2502.    else
  2503.  
  2504.    for node := 1 to nodes do
  2505.    begin
  2506.       openfiles(node);
  2507.       scanfile(node);
  2508.    end;
  2509.  
  2510.    Endtime := Time;
  2511.    runtime := Endtime-start_time;
  2512.  
  2513.    gotoxy(30, 17);
  2514.    writeln('Elapsed Time:  ', runtime:  6:  1);
  2515.  
  2516.    output_results(outfile+'G');
  2517.  
  2518.    {disable colors and repeat for non-g file}
  2519.    red := '';
  2520.    green := '';
  2521.    yellow := '';
  2522.    blue := '';
  2523.    magenta := '';
  2524.    cyan := '';
  2525.    white := '';
  2526.    gray := '';
  2527.    output_results(outfile);
  2528.  
  2529.    save_state;
  2530.    gotoxy(1, 25);
  2531.    textcolor(LightGray);
  2532. end.
  2533.  
  2534.